private subroutine TablesGetFromUnit(unit, tables)
read a collection of tables from specified unit. File is already open.
Arguments:
unit unit of file in which table is contained
tables returned collection of tables
Arguments
| Type |
Intent | Optional | Attributes |
|
Name |
|
|
integer(kind=short),
|
intent(in) |
|
|
:: |
unit |
|
|
type(TableCollection),
|
intent(out) |
|
|
:: |
tables |
|
Variables
| Type |
Visibility | Attributes |
|
Name |
| Initial | |
|
integer(kind=long),
|
public |
|
:: |
count |
|
|
|
|
integer(kind=long),
|
public |
|
:: |
i |
|
|
|
|
integer(kind=short),
|
public |
|
:: |
ios |
|
|
|
|
integer(kind=long),
|
public |
|
:: |
j |
|
|
|
|
character(len=LINELENGTH),
|
public, |
POINTER
|
:: |
lines(:) |
|
|
|
|
character(len=300),
|
public |
|
:: |
string |
|
|
|
Source Code
SUBROUTINE TablesGetFromUnit &
( unit, tables )
USE Utilities, ONLY: &
!Imported routines:
GetUnit
! Module used:
USE StringManipulation, ONLY: &
! imported routines:
StringCompact, StringToUpper
IMPLICIT NONE
! Function arguments
! Scalar arguments with intent(in):
INTEGER (KIND = short), INTENT (IN) :: unit
! Array arguments with intent (out):
TYPE (TableCollection), INTENT (OUT) :: tables
! Local scalars:
INTEGER (KIND = short) :: ios
INTEGER (KIND = long) :: count
INTEGER (KIND = long) :: i, j
CHARACTER (LEN = 300) :: string
! Local Arrays:
CHARACTER (LEN = LINELENGTH), POINTER :: lines (:)
!------------end of declaration------------------------------------------------
!count the number of tables present in the file
ios = 0
count = 0
DO WHILE (ios >= 0)
READ (unit, "(a)",IOSTAT = ios) string
IF ( StringCompact (StringToUpper (string) ) == "TABLE START" ) THEN
count = count + 1
END IF
END DO
!allocate space for tables
ALLOCATE ( tables % elem (count) )
tables % number = count
!initialize tables from file
REWIND (unit)
i = 0
DO i = 1, count
!search beginning of next table
ios = TableFileSync (unit)
!Store significant lines in memory
CALL TableStoreLines ( unit, lines )
!Get title
tables % elem (i) % title = TableReadTitle (lines)
!get Id
tables % elem (i) % id = TableReadId (lines)
!check that id is not replicated
CALL CheckId(tables,i)
!count number of columns
tables % elem (i) % noCols = TableCountCols (lines)
IF ( tables % elem (i) % noCols == 0) THEN
CALL Catch ('error', 'TableLib', 'no columns found in table: ', &
argument = tables % elem (i) % id)
END IF
!allocate columns
ALLOCATE ( tables % elem (i) % col ( tables % elem (i) % noCols ) )
!count number of rows
tables % elem (i) % noRows = TableCountRows (lines)
!allocate rows
DO j = 1, tables % elem (i) % noCols
ALLOCATE ( tables % elem (i) % col (j) % row ( tables % elem (i) % noRows ) )
END DO
!read header unit and content of the tables.
CALL TableReadHeader ( lines, tables % elem (i) )
CALL TableReadUnit ( lines, tables % elem (i) )
CALL TableReadContent ( lines, tables % elem (i) )
! table is in memory: deallocate lines
DEALLOCATE (lines)
END DO
END SUBROUTINE TablesGetFromUnit
